home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / cmsqb101.zip / CMSMOD.BAS < prev    next >
BASIC Source File  |  1990-06-09  |  7KB  |  305 lines

  1. '******************************************************
  2. '*                                                    *
  3. '*  File Name:     CMSMOD.BAS                         *
  4. '*                                                    *
  5. '*  Description:   Contains all the source code       *
  6. '*                 necessary to play Creative Music   *
  7. '*                 System (CMS) files using a CMS     *
  8. '*                 compatable card (GameBlaster or    *
  9. '*                 SoundBlaster) and CMS driver       *
  10. '*                 (CMSDRV.COM).  This file may be    *           
  11. '*                 loaded as a program or a module.   *
  12. '*                                                    *
  13. '*  Requirements:  CMSDRV resident in memory.         *
  14. '*                 Interruptx in QuickLib             *
  15. '*                 (i.e. QW.QLB).                     *
  16. '*                                                    *
  17. '******************************************************
  18.  
  19.  
  20. DEFINT A-Z
  21.  
  22. TYPE RegTypeX
  23.    ax    AS INTEGER
  24.    bx    AS INTEGER
  25.    cx    AS INTEGER
  26.    dx    AS INTEGER
  27.    bp    AS INTEGER
  28.    si    AS INTEGER
  29.    di    AS INTEGER
  30.    flags AS INTEGER
  31.    ds    AS INTEGER
  32.    es    AS INTEGER
  33. END TYPE
  34.  
  35. DECLARE SUB CmsPlayMusic (Repeats%)
  36. DECLARE SUB CmsVersion (version$)
  37. DECLARE SUB CmsFindDriver (IntNum%, version$)
  38. DECLARE SUB CmsPauseMusic ()
  39. DECLARE SUB CmsContinueMusic ()
  40. DECLARE SUB CmsStopMusic ()
  41. DECLARE SUB WaitForKey (Key$)
  42. DECLARE SUB GetFileName (FileSpec$)
  43. DECLARE SUB GetCmsFile (FileSpec$)
  44. DECLARE SUB OpenCmsFile (FileSpec$)
  45.  
  46. CONST False = 0, True = NOT False
  47.  
  48. DIM SHARED Reg88X AS RegTypeX
  49.  
  50. ' Make all arrays DYNAMIC so the .CMS file won't get relocated
  51. ' and cause CMSDRV to lose track of it.
  52. '$DYNAMIC
  53.  
  54. ' The PlayFlag is used to synchronize the user program with the music.
  55. DIM PlayFlag AS INTEGER
  56.  
  57. ' CmsSong array is the .CMS file loaded from disc.
  58. DIM CmsSong(0) AS STRING * 32767
  59.  
  60. CLS
  61.  
  62. ' Set the default number of plays to 1.
  63. Repeats = 1
  64.  
  65. ' Call the routine that finds the driver interrupt number and version.
  66. CmsFindDriver IntNum, version$
  67.  
  68. SELECT CASE IntNum
  69.    CASE IS = False
  70.       PRINT "CMSDRV is not installed."
  71.       END
  72.    CASE ELSE
  73.  
  74. ' Users should modify these 2 lines to do what ever they want with
  75. ' the version number (i.e. check to see if it is 3.00 or greater)
  76. ' and interrupt number.
  77.       PRINT "CMSDRV Version "; version$
  78.       PRINT "CMSDRV is using interrupt &H"; HEX$(IntNum)
  79. END SELECT
  80.  
  81. ' Go get the name of the .CMS file to be played...
  82. GetFileName FileSpec$
  83. ' ...and load it into memory.
  84. GetCmsFile FileSpec$
  85.  
  86. ' This is the main part of the program. The one shown is a mini program
  87. ' just to demonstrate how the routines are used.
  88. DO
  89.    WaitForKey Key$
  90.    SELECT CASE Key$
  91.       CASE "T"
  92.          CmsStopMusic
  93.       CASE "P"
  94.          CmsPauseMusic
  95.       CASE "C"
  96.          CmsContinueMusic
  97.       CASE "S"
  98.          CmsPlayMusic Repeats
  99.       CASE "Q"
  100.          CmsStopMusic
  101.          END
  102.       CASE "N"
  103.          GetFileName FileSpec$
  104.          CmsStopMusic
  105.          GetCmsFile FileSpec$
  106.    END SELECT
  107.  
  108. LOOP
  109.  
  110. REM $STATIC
  111. 'This sub continues music play after a pause.
  112. 'Entry conditions:
  113. '  AH = 3
  114. 'Exit conditions:
  115. '  AX = 0 successful
  116. '  AX = 1 no song had been paused
  117. '
  118. SUB CmsContinueMusic
  119.  
  120. Reg88X.ax = &H300
  121. CALL Interruptx(&H80, Reg88X, Reg88X)
  122.  
  123. END SUB
  124.  
  125. 'This sub disables the CMS break function (CTRL-Keypad5)
  126. 'Entry conditions:
  127. '  AH = 5
  128. 'Exit conditions:
  129. '  None
  130. '
  131. SUB CmsDisableBreak
  132.  
  133.  
  134. Reg88X.ax = &H500
  135. CALL Interruptx(&H80, Reg88X, Reg88X)
  136.  
  137. END SUB
  138.  
  139. 'This sub searches for the CMS driver CMSDRV.COM beginning at the INT 80h
  140. 'jump address thru INT 0BFh.  When the SUB finds the string "CMSDRV" at
  141. 'offset 104h of the interrupt, the interrupt number used by CMSDRV.COM is
  142. 'returned to the main program.
  143. '
  144. SUB CmsFindDriver (Inter, Ver$)
  145.  
  146. CONST CMSDRV$ = "CMSDRV"
  147. CONST MaxInter = &HBF, StartInter = &H80
  148.  
  149. RightString = False
  150. Inter = StartInter
  151.  
  152. DO
  153.    DEF SEG = 0
  154.    SegmentLo = PEEK((Inter * 4) + 2)
  155.    SegmentHi = PEEK((Inter * 4) + 3)
  156.    Segment = SegmentHi * 256 + SegmentLo
  157.    DEF SEG = Segment
  158.    Offset = &H104
  159.    i = 1
  160.  
  161.    DO
  162.       x$ = CHR$(PEEK(Offset))
  163.          IF x$ = MID$(CMSDRV$, i, 1) THEN
  164.             RightString = True
  165.             Offset = Offset + 1
  166.             i = i + 1
  167.          ELSE
  168.             RightString = False
  169.          END IF
  170.    LOOP WHILE (RightString = True) AND (i <= LEN(CMSDRV$))
  171.  
  172.    IF RightString = True THEN
  173.       CmsVersion Ver$
  174.       EXIT DO
  175.    END IF
  176.  
  177.    Inter = Inter + 1
  178. LOOP WHILE (Inter <= MaxInter)
  179.  
  180. DEF SEG
  181. IF Inter > MaxInter THEN Inter = False
  182.  
  183. END SUB
  184.  
  185. 'This sub pauses the music currently playing.
  186. 'Entry conditions:
  187. '  AH = 2
  188. 'Exit conditions:
  189. '  AX = 0 successful
  190. '  AX = 1 no music was being played
  191. '
  192. SUB CmsPauseMusic
  193.  
  194. Reg88X.ax = &H200
  195. CALL Interruptx(&H80, Reg88X, Reg88X)
  196.  
  197. END SUB
  198.  
  199. 'This sub plays music from a .CMS music file.
  200. 'Entry conditions:
  201. '  AH = 1
  202. '  AL = number of times to play (1-255; 0 for non-play)
  203. '  ES = segment address of PLAY-FLAG
  204. '  BX = offset address of PLAY-FLAG
  205. '  CX = segment of music score (.CMS file in memory)
  206. 'Exit conditions:
  207. '  AX = 0 successful
  208. '  AX = 1 non-CMS file structure
  209. '  AX = 2 wrong COMPOSEr version
  210. '
  211. SUB CmsPlayMusic (Rpts)
  212.  
  213. SHARED PlayFlag AS INTEGER
  214. SHARED CmsSong() AS STRING * 32767
  215.  
  216. Dummy& = FRE("")
  217. PfSeg = VARSEG(PlayFlag)
  218. PfOff = VARPTR(PlayFlag)
  219. MSeg = VARSEG(CmsSong(0))
  220.  
  221. Reg88X.ax = &H100 + Rpts
  222. Reg88X.es = PfSeg
  223. Reg88X.bx = PfOff
  224. Reg88X.cx = MSeg
  225.  
  226. CALL Interruptx(&H80, Reg88X, Reg88X)
  227.  
  228. END SUB
  229.  
  230. 'This sub stops playing the current music.
  231. 'Entry conditions:
  232. '  AH = 4
  233. 'Exit conditions:
  234. '  None
  235. '
  236. SUB CmsStopMusic
  237.  
  238. Reg88X.ax = &H400
  239. CALL Interruptx(&H80, Reg88X, Reg88X)
  240.  
  241. END SUB
  242.  
  243. ' This sub gets the the version number of the .CMS driver and returns
  244. ' it as Ver$.
  245. '
  246. SUB CmsVersion (Ver$)
  247.  
  248. Reg88X.ax = 0
  249. CALL Interruptx(&H80, Reg88X, Reg88X)
  250. SELECT CASE LEN(HEX$(Reg88X.ax))
  251.    CASE IS = 3
  252.       Ver$ = LEFT$(HEX$(Reg88X.ax), 1) + "." + RIGHT$(HEX$(Reg88X.ax), 2)
  253.    CASE IS = 4
  254.       Ver$ = LEFT$(HEX$(Reg88X.ax), 2) + "." + RIGHT$(HEX$(Reg88X.ax), 2)
  255. END SELECT
  256.  
  257.  
  258. END SUB
  259.  
  260. ' This routine loads a .CMS file (FSpec$) from disc
  261. ' into CmsSong array.
  262. '
  263. SUB GetCmsFile (FSpec$)
  264.  
  265. SHARED CmsSong() AS STRING * 32767
  266.  
  267. OPEN FSpec$ FOR BINARY AS #1
  268. GET #1, , CmsSong(0)
  269. CLOSE #1
  270.  
  271. END SUB
  272.  
  273. SUB GetFileName (FileSpec$)
  274.  
  275. GoodFile = True
  276. LOCATE 3, 1
  277. PRINT SPACE$(79)
  278. LOCATE 10, 1
  279. INPUT "Which drive and path"; Drive$
  280.  
  281. FILES Drive$ + "*.cms"
  282.  
  283. DO
  284.    LOCATE 3, 1
  285.    LINE INPUT "Enter CMS file name: "; FileSpec$
  286. LOOP WHILE GoodFile = False
  287. FileSpec$ = Drive$ + FileSpec$
  288.  
  289. END SUB
  290.  
  291. SUB WaitForKey (K$)
  292.  
  293. LOCATE 5, 1
  294. PRINT "N)ew file, S)tart, C)ontinue, P)ause, T)erminate, Q)uit: ";
  295.  
  296. DO
  297.    K$ = INKEY$
  298. LOOP WHILE K$ = ""
  299.  
  300. K$ = UCASE$(K$)
  301. PRINT K$;
  302.  
  303. END SUB
  304.  
  305.